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«TITLE MATRIX 
-IDENT /1-004/ ; File: MATRIX.MAR Edit: LEB1004 


PRR RA SRE AAA AREA EEAETAAAAAEAARAEAEAAAEREEAEEAERAReeeeeeeeeeeeeeeeeeeeerereee 


COPYRIGHT (c) 1978, 1980, 1982, 1984 BY 
DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. 
ALL RIGHTS RESERVED. 


THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED 
ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE 
INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER 
COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY 
OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY 


gz 
® 
® 
® 
® 
* 
® 
® 
& 
® 
TRANSFERRED. * 
® 
® 
e 
® 
® 
© 
® 
e 
® 


THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE 
pemPOkat itn NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT 


DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS 
SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. 


Be Ge Ge Ge Se Ge Ge Ge Ge Ge Ge Ge Se Se Se Ge Ge Ge Ge Ge Ge 
eeeeneeee eee eee ee een eaeenen 


SHAKER AREER AEAAAAAARAREAAEARAEAAEAAAAEAEAEAAEAAEAEAEEAAEAREAERERERAEEE Ee 


ae 
FACILITY: BASIC code support 
ABSTRACT: 


ENVIRONMENT: User Mode, AST Reentrant 


MODIFIED BY: 
oe 


1-001 = Original - contains FETCH and STORE macros 
1-002 = Added code to handle orreys of descriptors. Needed to add 
label declarations at beg maine of each macro. LEB 23-June-1982 
1-005 - In the FETCH macro, after calling BASSFETCH_BFA the value must 
be moved into RO. PLL 28-Jun-19 
1-004 - Use offsets from the stack. LEB 9-Jul-1982 
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-SBTTL DECLARATIONS 
INCLUDE FILES: 


SOSCDEF 
SSFDEF 


EXTERNAL DECLARATIONS: 


a 1g 
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define descriptor offsets 
use to get scale 


-DSABL GBL ; Prevent g oye 

; symbols from te 

3 qetenes een gt g al. 
-EXTRN BASSK_ARGDONMAT 3; signalled if al blocks 

; not present in array desc 

; or dimct = 
-EXTRN BASSK_DATTYPERR 5 signalled if dtype of array 

3; isn't word bond float double 
-EXTRN BASSK_MATDIMERR 3; signalled if # dims on 

; source Rik. don’ t agree 
-EXTRN BASSK_ARRMUSSAM 3; signalled if upper and lower 

3; bnds not same on src arrays 
-EXTRN BASSSTO_FA_W_R8 3 array element store for word 
-EXTRN BASSSTO_FA_L_R8 3 array element store for long 
-EXTRN BASSSTO_FA_F_R8 3; array element store - float 
-EXTRN S$STO_FA_D_R8 ; array element store - double 
-EXTRN BASSSTO_FA_B_R8 ; array element store - Oyte 
-EXTRN BASSSTO_FA_G_R8 3; array element store - 9 Loat 
-EXTRN BASSSTO_FA_H_R8 3; array element store - hfloat 
e-EXTRN BASSFET_FA_W_R8 3; array element fetch - word 
-EXTRN BASSFET_FA_L_R8 3; array element fetch - long 
-EXTRN BASSFET_FA_F_R8 3; array element fetch - float 
-EXTRN BASSFET_FA_D_R8 3; array element fetch - double 
-EXTRN BASSFET_FA_B_RB 3 array element fetch - byte 
-EXTRN BASSFET_FA_G_R8 3; array element fetch - gfloat 
-EXTRN BASSFET_FA_H RB 3; array element fetch - hfloat 
-EXTRN BASSMAT_REDIA : check if redimensioning of 

3 woot arrey is necessary, if 
eEXTRN BASSSSCALE R1 3 scale for double procision 
-EXTRN MTHSDINT_R& 3 truncate dbl precision number 
eEXTRN BASSSer 3; signal fatal errors 
-EXTRN BASSFETCH_BFA 
-EXTRN BASSSTORE_BFA 

MACROS: 

FETCH fetch an element from an array 
STORE store an element into an array 


: EQUATED SYMBOLS: 
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aecs 


OWN STORAGE : 


> PSECT DECLARATIONS: 
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Be Ge Ge Ge Ge Ge Ge Se Se Se 


-PSECT _BASSCODE PIC, USR, CON, REL, LCL, 
EXE, RD, NOWRT, LONG 


stack offset for 
stack offset for 
stack offset for 
stack offset for 
desc offset i 
desc offset i 
desc offset i 
desc offset i 
desc offset i 
desc offset i 


SHR, = 


temp 
temp 


| CU 


M14 
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+ 


L12: 


L10: 


Li: 


L11: 


L2: 


These macros are a substitute for calls to the array fetch and store 
routines. They will call the BASS routines ently if phe array is a 
virtual array. Otherwise, they will calculate n 
the array via the INDEX instruction. (Note that BASIC progress must 
be able to handle FORTRAN arrays, so the code must che ereys 
stored by column.) The INDEX instructions should provide a significant 
ber voracsee improvement over calling a routine for each element of 

y- 


he Linear index into 


for 


MACRO FETCH array_dtype,?L1,?L2,7L3,?7L10,7L11,2L12,2L21 ; fetch an array element 


CMPB o Sb_dtype(RO), Mdsc$k_dtype_dsc ; descriptor? 


MOVL 4(RO), RS ; fetch addr of descriptor 
MOVB dsc$b_dtype(R4), dtype(SP) 3; store data type from desc 
MOVB dsc$b_class(R4), class (SP) 3; store class from desc 
MOVAL data(SP), pointer (SP) 

MOVW #10, str_len(SP) 

CMPB dsc$b_dimct(RO), #1 ; check # of dimensions 
BNEQ Li2 3; branch if 2 dimensions 
PUSHL R11 3; value of ist index 
PUSHAL value_desc+4(SP) 3; addr of value desc 

PUSHL ; addr of array desc 

CALLS #3,G*BASSFETCH_BFA 

slag aida data(SP), RO ; put value into RO 


R2 
PUSHL R1 
PUSHAL value_desc+8(SP) 
PUSHL 
CALLS #4,G*BASSFETCH_BFA 
on ere gitype’ data(SP), RO ; put value into RO 
dsc$b_class(RO), #dsc$k_class_bfa ;virtual array? 

3: no 

JSB G*BASSFET_FA_‘array_dtype’_R8& =; yes, use the fetch routine 


4 
BBS #5, 10(RO), L2 
CMPB Sect diact (RD), #] 


2 dims 
MOVZWL dsc$w_length(RO), R4 ; make Length_longword 
INDEX R1, dsc$L_11_1(RO), dsc$l_u1_1(RO), R4, #0, R3 

ADDL dsc$a_a0(RO), R3 3; add start addr to offset 
ey orre dtype' (R3), RO 3 return element in RO 


3; value of 2nd index 
3; value of ist index 
3; addr of value desc 
; addr of array desc 


one 
br if_array stored by cols 
1 or 2 dims? 


wW - 1 dim done 
INDEX R17, dsc$l_l1_2(RO), dsc$l_u1_2(RO), dsc$l_m2(RO), #0, R3 
; 1 * M2 “CLi's are zero) 
MOVZWL dsc$w_length(RO), R4 > need longword length for INDEX 
INDEX 2, dsc$i_l2_2(RO), dsc$l_u2_2(RO), R4, R3, 
3 WW ¢° CL & M2)) © Length 


ADDL dsc$a_a0(RO), R3 


my orre dtype’ (R3), RO 
CMPB dsc$b_dimct(RO), #1 


compute addr of element 
; return element in RO 


: done 
3; 1 or 2 dims? 


4 


4 
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NEQ : 2 dims 
MOVZWL dscty. Ls Length(RO), R4 nese length Longword 
INDEX $1-11_1(R6), dsc$t_ul 106), #0, R 
DDL dsc$a a0(RO) > R3 ; Sea” Start addr to offset 
ee arre dtype' (R3), RO ; on Suenem in RO 
INDEX ‘3. dsc$l_l2_2(RO), dsc$l_u2 -2(R decsl -m1 (RO), #0, R3 
js “CLi's are zero) 
MOVZWL a _Length(RO) need” he Length for INDEX 
INDEX , dsc$t_l1 RO) "cock _ul -2nis" 
(1 +°(j # M1)) ® Length 
ADDL dsc$a ~20(RO), R3 : compute addr of element 
MOV array_dtype' (R3), RO ; return element in RO 


-ENDM 


1 
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-MACRO STORE array _dtype,?L1,7L2,?L3,27L4,?7L5,7L6,7L7,2L8, 2L9, 2410, 2411, 2412, 221, 2L30, ™ 31, 2L32,2L41, 72L50,7L51,2L52, ?2L61, 


i IDN ortay atype. 4 array is hfloat 
CHB ds Sb_dtype(R4J, dsc$k.dtype_dse ; descriptor? 
MOVL 4(R4), RO ; fetch addr of oar: 
MOvVB dsc$b_ _dtype(RO), dtype(SP) ; load in data type 
MOVB dsc$b class(RO), class(SP) 3; load in class field 
MOVAL deta(SP), pointer (SP) 
MOVW 10, str_len(SP) 
CMPB dsc$b. dimet(R4), #1 > check # of dimensions 
NEQ ; branch if 2 dimensions 
PUSHL R5 ; value of ist index 
PUSHL R4 ; addr of array desc 
PUSHAL value _desc+8(SP) ; addr of value desc 
CALLS a. G*BASSSTORE_BFA 
PUSHL te : value of 2nd index 
PUSHL RS 3; value of Ist index 
PUSHL R4 ; addr of array desc 
PUSHAL value _desc+12(SP) ; addr of value desc 
CALLS "3° -G*BASSSTORE_BFA 
pest, class(R4), #dsc$k_class -bfa 3; virtual array? 
3 no 
Pa ‘C eeaties FA_‘array_dtype'_R8& = ; yes. call store routine 
BBS #5, 10(R4), L2 : ys it stored row-wise 
CMPB éocSe _dimct(R4), #1 : 1 or 2 dim? 
BNEQ L11 : 2 dims 
MOVZWL dsc$w gigreretee? make Tength longword 
INDEX R5, dsc$l_L Tera)” FascSt _ul -10R4)" R8, #0, R7 
ADOL dsc$a_ 30 (RG) 7 " : add start addr to offset 
a arre dtype’ RO, (R7) : ptore ol ee from RO 
INDEX RS, dsc$l_L1_2(R4), dsc$l_ul are dscs\. one (RG), #0, R7 
MOVZWL dsc$w_length(R4) . a Length for INDEX 
INDEX R6, dsc$l_L2 Ra) "dscB1u2_20Rb) 
tJ 3 aD) * Length 
ADDL dsc$a ~20(R4), R7 : Aa addr of element 
are dtype' RO, (R7) 3; store element from RO 
CMPB dsc$b_dimct(R4), #1 : or - dim? 
BNEQ L21 23 
MOVZWL dscSu SS ier: ia “Length lLongword 
INDEX 6, dsc$L_L Terk)” e iscSt ul “sas 
ADDL dsc$a “a0 Ri) R7 : ad J tesrt oe to offset 
a ore dtype' RO, (R7) : tere - sem from RO 
m done 
R6, dsc$l_l2_2(R4), dsc$l_u2 ey dsc$l_ mi(R4), #0, R7 
MOVZWL dsc$w_length(R4) nen tongth for INDEX 
INDEX 5, dSc$i_L1 RE) “ascBt ut 20nb 


tl 3m) * Length 
ADDL dsc$a_a0(R4), R7 3 eepath addr of element 


MATRIX.MAR; 1 
wy ore. dtype' RO, 
cIF IDN arra 
BNEQ 


L32: 


L30: 


L3: 


L31: 


L4: 


L41: 


w RO), dtype(S 
MOVB dsc$b_class(RO), class(S 
MOVAL dera(sh). pointer (SP) 
MOV str_len(SP) 
CMPB dscbo. dimct(R2), #1 
BNEQ i 
PUSHL R 


PU R2 

PUSHAL value _desc+8(SP) 

CALLS #3,G°BASSSTORE BFA 
U3 

PUSHL Ra 


R2 
PUSHAL value _desc+12(SP) 
cALS c -G*BASSSTORE_BFA 


(R7) 


dtype’, G 
CMPB dsc $b. dtypecRey” basc$k dtype_dsc ; descr 


16-SEP-1984 17:03: ob % Page 7 


; store element from RO 


array is gfloat 
; iptor? 


; fetch addr of descriptor 
; load in data t 
3; load in class La 


check # of dimensions 
branch if 2 dimensions 
value of ist index 
addr of array desc 
addr of value desc 


value of 2nd index 
value of Ist index 
addr of array desc 
addr of value desc 


CMPB 4 c$b_class(R2), #dsc$k_class -bfa : virtual array? 


JSB G*BASSSTO_ FA_‘array_dtype'_R8 


L 
BBS #5, 10(R2), 
CMPB ds $b_ dtect (he), 


3; no 
: ed call store routine 


: ~4 ‘¢ stored row-wise 
3 } or 2 dim? 


dims 
make Length, Longuord 


INDEX R3, dsc$l_L nd), po _ul 1¢R3)" R6, #0 
ADDL dsc$a_a ted) RS : add start addr to offset 
ore dtype' RO, (R5) ; gtece eneen from RO 
INDEX R3, dsc$l_L1_2(R2), dsc$l_ul nb bi m2(R2), #0, RS 
MOVZ7WL Soctu _length(R2) mens Loogth for INDEX 
INDEX . dsc$l_l2_ BcRS) "dsc$t_u2_20R8) 
ie dé m2) * Length 
ADDL dsc$a ~20(R2), RS : Sie addr of element 
a are dtype’ RO, (RS) 3; store element from RO 
CMPB ds¢$b_ dimct(R2), : l or 2 dim? 
BNEQ L41 3; 2 dims 
ee dscSu “erty. ache Length Longword 
IND EX R4&, dsc$L_L Ter)” SascSt ul 10rd)" #0, RS 
aa) dsc$a *50(R2)7 R5 : F. Start addr to offset 
V'array_dtype' RO, (RS) : Pare Se qhenens from RO 
INDEX R46, dsc$l_l2_2(R2), dsc$l_u2 cath ascst oni (R2), #0, RS 
red py + he Length(R2) cath Legeth for INDEX 
dsc$i_ 11 iRDD. “sett 2088) ; 


ADDL dsc$a_a0(R2), RS 


une * ma)? * Length 
r Ae addr of element 


-- — CO a 
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| MATRIX.MAR;1 
wy errr. dtype' RO, (RS) ; store element from RO 
if IDN array dtype’, D array is double 
es | dsc $b. dtype Ray” basc$k_dtype_dsc : descriptor? 
MOVL 4(R2), RO ; fetch addr of descriptor 
MOVB dsc$b ~Adt ype (RO) Streeter? ; load in data t type 
MOVB dsc$b_class(R ); class(SP) ; load in class field 
MOVAL data(SP), pointer (SP) 
MOVW #10, str_len(SP) 
CMPB d dsc $b_ Siactcrs). #1 3; check # of dimensions 
BNEQ ; branch if 2 dimensions 
PUSHL ; value of Ist index 
PUSHL ne ; addr of array desc 
PUSHAL uve_desc+8(S ; addr of value desc 
aa as. eeAec tone OFA 
L52: PUSHL 3; value of 2nd index 
PUSHL Ra ; value of Ist index 
PUSHL R2 3; addr of array desc 
PUSHAL value _desc+12(SP) ; addr of value desc 
— t -G*BASSSTORE BFA 
L50: Tee dgc$b_ class(R2), @dsc$k_class_bfa ; virtual array? 
3: no 
= Cpretten FA_‘array_dtype'_R8& = ; —_ store routine 
LS: BBS #5, 10(R2), 3 ~¥ i stored col-wise 
CMPB dsc$b_ Steck (ho). ; 1 or 2 dim? 
BNEQ L51 : .. Sg 
MOVZWL en see ett tte e' Length Longword 
INDEX R3, dsc$l_L “Nth: Sascst _ul 1rd), “AS. #0, RS 
ADDL dsc$a_a0 Str) RS 3 add start addr to offset 
MOV’ array _dtype' RO, (RS) ; store element from RO 
BRW > 1 dim done 
L51: INDEX R3, dsc$l_l1_2(R2), een dts dsc$l_ m2(R2), #0, RS 
MOVZWL Goctu _length(R2) a length for INDEX 
INDEX » dsc$l_l2_ Bird)” “dsc$t_u2_20R8) ; 
(1 * M2)) © Length 
ADDL dsc$a ~20(R2), RS : ty ol addr of element 
ae area dtype' pe (R5) : store element from RO 
L6: CMPB dsc$b_dimct(R2), ; 1 or 2 dim? 
BNEQ L61 : a bg 
pad oy dsc wget) e' Length Longword 
INDEX 1R2), Sascst _ul 10rd), #0, RS 
ADDL iy *40( 2), R ; san” Start addr to offset 
re dtype' 0, (R5) : gtece gionent from RO 
L61: INDEX R4, dsc$l_l2_2(R2), dsc$l_u2 2, dsc$l_ mi(R2), #0, RS 
MOVZWL g3c$u_ Length(R2) a a Length for INDEX 
INDEX R3, dsc$i_l1 RD) Sascst _ul -2(R2) 
us "(jt mt) * Length 
ADDL dsc$a_a0(R2), R5 > compute addr of element 


——— 


| 


1 
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MOV" array_dtype' RO, (R5) : store element from RO 
lf F array type other than double 
re ds¢Sb_ dtype(R1), Hdsc$k_dtype_ds¢ ; descriptor? 
MOVL 4(R1), RO 3; fetch addr of eeermpeet 
MOVB dsc$b “dtype(RO), dtype(SP) ; load in data type 
MOVB dsc$b-class(RO), class(SP) 3; load in class field 
MOVAL GeratsP). pointer: (SP) 
MOVW str_len(SP) 
CMPB dscbo. dimet(Ri), #1 ; check # of dimensions 
BNEQ 3 branch if 2 dimensions 
PUSHL Re : value of Ist index 
PUSHL 3; addr of array desc 
PUSHAL act desc+8(SP) ; addr of value desc 
Ae #3,G°BASSSTORE BFA 
L72: PUSHL i 3; value of 2nd index 
PUSHL : ; value of ist index 
PUSHL ; addr of array desc 
PUSHAL ue_desc+12(SP) 3; addr of value desc 
ar a. Ra Tt ttt BFA 
L70: ag dsc$b_class(R1), @dsc$k_class_bfa ;virtual array? 
3 no 
had CO eeeton. FA_‘array_dtype'_R8& = ; — store routine 
L?: BBS #5, 10(R1), L8 : br 1¢ stored eot-utes 
es dc $b_ dinct (Ri), r A : } “2 2 dim? 
MOVZWL facie _lLength(R1), R5 > make Length, lLongword 
INDEX R2, dsc$l_l1_1(R1), dsc$l_ul “1rd. RS, #G, 
ADOL dsc$a_a0( (R1)> RG ; add start 2 to offset 
MOV’ array _dtype' RO, (R4) 3; store element from RO 
BR : 1 dim done 
L71: INDEX R2, dsc$l_l1_2(R1), dsc$l _ul e's dsc$l_ m2(R1), #0, R4 
MOVZWL dscS$w_length(R1) aan, length for INDEX 
INDEX R3, dsc$l_L2 Rh > asc$t _u2_ 2cRi) 
# M2)) * Length 
ADDL dsc$a ~20(R1), Rg : ~ Hl. addr of etengnt 
ae dtype' RO, (R4) : atore element from R 
L8: cMPB dsc$b_ dimct(R1), #1 : 7 ‘ad 2 dim? 
MOVZWL ar se$tett ti oe ‘8 Length Longword 
INDEX R3, dsc$l TRE) > ascSt _ul vai R4 
or Ry a0 (RI 7 R ; saert addr to offset 
V'array_dtype' RO, (R4) : store Sienent from RO 
L81: INDEX R3, dsc$l_l2_2(R1), dsc$l_u2 ae, dsc$l_ mi(R1), #0, R4& 


MOVZ 
I 


ADDL 
MOv" 


WL dsc$w_length(R1) 


NDEX R2, dsc$l_L1 Hit. oe _ul -20R) 


dsc$a_ aQ(R1), 
array_dtype’ RS e0. (R4) 


Rens, length for INDEX 
(1 4°(5 & M1) ® Length 


: Dotonakt addr of element 
3; store element from RO 


fF 1 
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